home *** CD-ROM | disk | FTP | other *** search
/ PsL Monthly 1993 December / PSL Monthly Shareware CD-ROM (December 1993).iso / prgmming / dos / pascal / arith2.com / ADAP_MOD.PAS next >
Encoding:
Pascal/Delphi Source File  |  1989-02-27  |  5.0 KB  |  185 lines
  1. UNIT adap_mod;
  2.  
  3. {$O+}
  4.  
  5.         { ------------------------------------------------------------------
  6.  
  7.           This program and its associates implement in Turbo Pascal v5
  8.           the aritmetic encoding/decoding algorithms presented in the papers
  9.  
  10.           "Arithmetic Coding for Data Compression"
  11.  
  12.                    by Ian     H. Witten
  13.                       Radford M. Neal
  14.                       John    G. Cleary
  15.  
  16.           pp 520 - 540 of June 1987 Communications of the ACM
  17.  
  18.           and
  19.  
  20.           "An Adaptive Dependency Source Model For Data Compression"
  21.  
  22.                    by David M. Abrahamson
  23.  
  24.           pp 77 - 83 of January 1989 Communications of the ACM
  25.  
  26.           ------------------------------------------------------------------
  27.  
  28.           Implemented by Ken Westerback : CompuServe 73547,3520
  29.  
  30.           version 1.0 released 89/02/19
  31.           version 2.0 released 89/02/27
  32.  
  33.           These programs, units and associated documentation are released
  34.           into the public domain to be used and abused as your whims
  35.           dictate.
  36.  
  37.           Feel free to distribute/incorporate/improve as desired.
  38.  
  39.           >>>>> Use at your own risk! <<<<<
  40.  
  41.           Comments and suggestions welcome via CompuServe.
  42.  
  43.           ------------------------------------------------------------------
  44.         }
  45.  
  46. INTERFACE
  47.  
  48.  
  49. const model_name = 'Adaptive Model';
  50.  
  51. { this procedure initializes the model - must be exported cuz we }
  52. { may be overlay'ed                                              }
  53.  
  54. procedure start_model;
  55.  
  56. function  select_char   ( symbol : integer ) : char;
  57.  
  58. function  select_symbol (     ch : char    ) : integer;
  59.  
  60. procedure update_model  ( symbol : integer );
  61.  
  62.  
  63. IMPLEMENTATION uses model_h;
  64.  
  65. { make these arrays dynamic so multiple model overlays will not }
  66. { use up unnecessary memory, or worse, use the same memory for  }
  67. { different things!                                             }
  68.  
  69. type ctoi_array = array [ 0..no_of_chars-1 ] of integer;
  70.      itoc_array = array [ 0..no_of_symbols ] of char;
  71.  
  72.      ctoi_p = ^ctoi_array;
  73.      itoc_p = ^itoc_array;
  74.  
  75. var char_to_index : ctoi_p; { to index from character }
  76.     index_to_char : itoc_p; { to character from index }
  77.  
  78.  
  79. procedure start_model;
  80.  
  81.           var i : integer;
  82.  
  83.           begin
  84.  
  85.           new ( char_to_index );
  86.           new ( index_to_char );
  87.  
  88.           { set up tables that translate between symbol indexes and }
  89.           { characters                                              }
  90.  
  91.           for i := 0 to no_of_chars-1 do
  92.               begin
  93.               char_to_index^[ i   ] := i + 1;
  94.               index_to_char^[ i+1 ] := chr ( i );
  95.               end;
  96.  
  97.           { set up initial frequency counts to be one for all symbols }
  98.  
  99.           for i := 0 to no_of_symbols do
  100.               begin
  101.               freq    [ i ] := 1;
  102.               cum_freq[ i ] := no_of_symbols - i;
  103.               end;
  104.  
  105.           { freq[ 0 ] must not be the same as freq[ 1 ] }
  106.  
  107.           freq[ 0 ] := 0;
  108.  
  109.           end;
  110.  
  111. function select_symbol ( ch : char ) : integer;
  112.  
  113.          begin
  114.  
  115.          select_symbol := char_to_index^[ ord(ch) ];
  116.  
  117.          end; { select symbol }
  118.  
  119.  
  120. function select_char ( symbol : integer ) : char;
  121.  
  122.          begin
  123.  
  124.          select_char := index_to_char^[ symbol ];
  125.  
  126.          end; { select_char }
  127.  
  128.  
  129. procedure update_model ( symbol : integer );
  130.  
  131.           var i, cum, ch_i, ch_symbol : integer;
  132.  
  133.           begin
  134.  
  135.           { see if frequency counts are at their maximum.  if they are }
  136.           { then halve all counts, keeping them non-zero               }
  137.  
  138.           if ( cum_freq[ 0 ] = max_frequency ) then
  139.              begin
  140.              cum := 0;
  141.              for i := no_of_symbols downto 0 do
  142.                  begin
  143.                  freq[ i ] := ( freq[ i ] + 1 ) div 2;
  144.                  cum_freq[ i ] := cum;
  145.                  inc ( cum, freq[ i ] );
  146.                  end;
  147.              end;
  148.  
  149.           { find symbol's new index }
  150.  
  151.           i := symbol;
  152.           while freq[ i ] = freq[ i-1 ] do dec ( i );
  153.  
  154.           { update the translation tables if the symbol has moved }
  155.  
  156.           if ( i < symbol ) then
  157.              begin
  158.  
  159.              ch_i      := integer ( index_to_char^[      i ] );
  160.              ch_symbol := integer ( index_to_char^[ symbol ] );
  161.  
  162.              index_to_char^[      i ] := chr ( ch_symbol );
  163.              index_to_char^[ symbol ] := chr ( ch_i      );
  164.  
  165.              char_to_index^[ ch_i ] := symbol;
  166.              char_to_index^[ ch_symbol ] := i;
  167.  
  168.              end;
  169.  
  170.           { increment the frequency count for the symbol and update }
  171.           { the cumulative frequencies                              }
  172.  
  173.           inc ( freq[ i ] );
  174.  
  175.           while ( i > 0 ) do
  176.                 begin
  177.                 dec ( i );
  178.                 inc ( cum_freq[ i ] );
  179.                 end;
  180.  
  181.           end; { update_model }
  182.  
  183.  
  184. END. { adaptive model implementation }
  185.